home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / dndlb.exe / DNDLB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-16  |  25.7 KB  |  739 lines
  1. {$D-,L-,Y-}
  2.  
  3. UNIT DndLB; { Drag 'n Drop List Box }
  4.  
  5. { :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  6.  
  7.   Unit:          DndLb
  8.  
  9.   Author:        Ian Hayes
  10.                  Soft Systems Ltd.,
  11.                  London, UK
  12.                  Compuserve id: 100010,1415
  13.  
  14.   Description:
  15.  
  16.      A new listbox object for implementing the dragging of listbox
  17.      items either to new positions in the current listbox or to
  18.      other drag-friendly listboxes.
  19.  
  20.   Object name:
  21.  
  22.      TDndListBox
  23.  
  24.   Parent Object:
  25.  
  26.      TTwoWayListBox (refer to the TwoWayLb.Pas unit).
  27.  
  28.   Object data fields:
  29.  
  30.      DelOnTrfr   : BOOLEAN;
  31.  
  32.          If set to TRUE then when an item is dragged to another
  33.          listbox then it is deleted from the starting listbox.
  34.  
  35.      KeepSel     : BOOLEAN;
  36.  
  37.         If set to TRUE then the dragged item retains its
  38.         highlighted status, even if dragged to another listbox.
  39.  
  40.      DragExtent  : TRect;
  41.  
  42.         The default rectangle area measured in absolute screen
  43.         co-ordinates over which the mouse may drag a listbox item.
  44.         By default this is set to the screen position equivalent
  45.         of the owning dialog's client rectangle. You can set
  46.         this to be a different rectangle based upon the
  47.         position of other listboxes. Note that the values in this
  48.         TRect are absolute screen co-ords. Its used to restrict
  49.         mouse movement using 'ClipCursor()'.
  50.  
  51.    Object methods:
  52.  
  53.       CONSTRUCTOR Init(AParent    : PWindowsObject;
  54.                        AnId       : INTEGER;
  55.                        x,y,w,h    : INTEGER;
  56.                        ADelOnTrfr : BOOLEAN);
  57.  
  58.          Creates a drag'n drop listbox object. If 'ADelOnTrfr' is
  59.          set to TRUE then if an item is dragged to another listbox
  60.          it is deleted from the starting listbox
  61.  
  62.       CONSTRUCTOR InitResource(AParent    : PWindowsObject;
  63.                                AnId       : INTEGER;
  64.                                ADelOnTrfr : BOOLEAN);
  65.  
  66.          Creates a drag'n drop listbox object to be associated
  67.          with the 'AnId' resource. If 'ADelOnTrfr' is set to TRUE
  68.          then if an item is dragged to another listbox it is deleted
  69.          from the starting listbox
  70.  
  71.       FUNCTION GetClassName : PChar; VIRTUAL;
  72.       PROCEDURE GetWindowClass(VAR AWndClass: TWndClass); VIRTUAL;
  73.  
  74.          Standard stuff.
  75.  
  76.       PROCEDURE SetupWindow; VIRTUAL;
  77.  
  78.          Sets the 'DragExtent' TRect to the absolute screen
  79.          co-ord equivalents of the owning dialog's client area.
  80.  
  81.       FUNCTION GetItemFromY(Y: INTEGER) : INTEGER;
  82.  
  83.          Returns a listbox item position number from a client
  84.          rectangle Y co-ordinate.
  85.  
  86.       PROCEDURE GetSelIndexRect(VAR ARect: TRect);
  87.  
  88.          Returns the rectangle position (in client co-ords) of
  89.          the current listbox item.
  90.  
  91.       PROCEDURE wmChgLbItemPos(VAR Msg: TMessage);
  92.          VIRTUAL wm_First + wm_ChgLbItemPos;
  93.  
  94.          This message is sent by the same listbox to itself whenever a
  95.          listbox item has been dragged to a new position. Msg.lParamlo
  96.          is the item number of the item being dragged; Msg.lParamHi is
  97.          the new position number - both numbers are base 0. If
  98.          Msg.lParamHi is -1 then the item is being moved to the end of
  99.          the list.
  100.  
  101.       PROCEDURE wmDelOnTrfr(VAR Msg: TMessage);
  102.          VIRTUAL wm_First + wm_DelOnTrfr;
  103.  
  104.          This message is sent by the listbox to itself whenever an item
  105.          has been dragged outside to another listbox. By default this
  106.          method will delete the dragged item from the starting lb if
  107.          the 'DelOnTrfr' boolean flag is set to TRUE. Msg.wParam holds
  108.          the item number.
  109.  
  110.       PROCEDURE wmGetDragExtent(VAR Msg: TMessage);
  111.          VIRTUAL wm_First + wm_GetDragExtent;
  112.  
  113.          Asks the receiving listbox for the current DragExtent
  114.          TRect values. Msg.lParam holds a ptr to a TRect
  115.          structure where the value is to be copied into. This allows
  116.          the dialog window to enquire about the drag extent.
  117.  
  118.       PROCEDURE wmGetItemDragExtent(VAR Msg: TMessage);
  119.          VIRTUAL wm_First + wm_GetItemDragExtent;
  120.  
  121.          Used to find the mouse clipcursor TRectangle for
  122.          a specified listbox item. Msg.wParam holds the listbox item
  123.          index (base 0); whilst Msg.lParam holds a pointer to a TRect
  124.          record. By default the message returns the standard DragExtent
  125.          TRect values assigned within the SetupWindow method. By
  126.          overriding this method you can set different drag extents
  127.          for different listbox items.
  128.  
  129.       PROCEDURE wmLButtonDown(VAR Msg: TMessage);
  130.          VIRTUAL wm_First + wm_LButtonDown;
  131.       PROCEDURE wmMouseMove(VAR Msg: TMessage);
  132.          VIRTUAL wm_First + wm_MouseMove;
  133.       PROCEDURE wmLButtonUp(VAR Msg: TMessage);
  134.          VIRTUAL wm_First + wm_LButtonUp;
  135.  
  136.          Controls the drag'n drop processing.
  137.  
  138.       PROCEDURE wmSetDragExtent(VAR Msg: TMessage);
  139.          VIRTUAL wm_First + wm_SetDragExtent;
  140.  
  141.          Used to set the listbox drag extent. You could send
  142.          this message from the owning dialog's SetupWindow method.
  143.  
  144.       PROCEDURE wmSetKeepSel(VAR Msg: TMessage);
  145.          VIRTUAL wm_First + wm_SetKeepSel;
  146.  
  147.          The 'KeepSel' object boolean data flag is used to
  148.          determine whether the item selected hilite bar should
  149.          be maintained on a listbox after an item has been
  150.          dragged into another listbox. This message is used
  151.          to update that flag. Msg.wParam holds a boolean value.
  152.  
  153.       PROCEDURE wmTrfrLbItem(VAR Msg: TMessage);
  154.          VIRTUAL wm_First + wm_TrfrLbItem;
  155.  
  156.          This message is received by a listbox when an item
  157.          from another listbox has been dragged over and dropped
  158.          onto this listbox. Msg.wParam holds the Other ListBox
  159.          window handle (hWnd); Msg.lParamLo is the item number
  160.          (base 0) of the other listbox item; Msg.lParamHi is
  161.          the absolute screen Y position where the item was
  162.          dropped. If the target listbox is able to accept the
  163.          dropped item then it returns Msg.Result set to non zero.
  164.          If the dropped item is not accepted then Msg.Result
  165.          is set to zero.
  166.  
  167.    Dependancies:
  168.  
  169.       Currently this unit derives from another TListBox type
  170.       called 'TTwoWayListBox' (refer to the TwoWayLb.pas unit).
  171.       It also makes use of some special string handling functions
  172.       (refer to the Strings1.Pas unit).
  173.  
  174.    Notes:
  175.  
  176.       At present this listbox object will only work with other
  177.       drag'n drop listboxes of the same class name. You can see
  178.       within the 'wmLButtonUp()' method that it checks for the
  179.       class name of the 'other' control. You might want to amend
  180.       this to expand the functionality.
  181.  
  182.       Also I can't seem to get the TDndListBox to work if the
  183.       listbox is created via 'Init'. As I only ever use dialogs
  184.       created with RW this is'nt a problem for me but somebody might
  185.       want to research this problem.
  186.  
  187.       Please pass all feedback/bugs on this unit to me at my
  188.       Compuserve id:
  189.  
  190.                     Ian Hayes
  191.                     Soft Systems Ltd,
  192.                     London,UK
  193.                     Compuserve id: 100010,1415
  194.  
  195.    :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }
  196.  
  197. INTERFACE
  198.  
  199. { ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }
  200.  
  201. USES
  202.  
  203.    {$IFDEF Ver70}
  204.       Objects,
  205.       OWindows,
  206.       ODialogs,
  207.    {$ELSE}
  208.       WObjects,
  209.    {$ENDIF}
  210.    WinProcs,
  211.    WinTypes,
  212.    Win31,
  213.    TwoWayLb;
  214.  
  215.  
  216. { ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }
  217.  
  218. CONST
  219.  
  220.    { Drag & Drop List box level custom messages }
  221.  
  222.    wm_ChgLbItemPos       = (wm_User+101);
  223.    wm_TrfrLbItem         = (wm_User+102);
  224.    wm_GetDragExtent      = (wm_User+103);
  225.    wm_SetDragExtent      = (wm_User+104);
  226.    wm_DelOnTrfr          = (wm_User+105);
  227.    wm_SetKeepSel         = (wm_User+106);
  228.    wm_GetItemDragExtent  = (wm_User+107);
  229.    wm_LastDndCustMsg     = wm_GetItemDragExtent;
  230.  
  231. TYPE
  232.  
  233.    PDnDListBox = ^TDnDListBox;
  234.  
  235.    TDndListBox = OBJECT(TTwoWayListBox)
  236.       { *** Data fields *** }
  237.       DelOnTrfr   : BOOLEAN;  { delete items if dragged to another lb? }
  238.       KeepSel     : BOOLEAN;  { if TRUE keep sel hilite on after trfr'ing
  239.                                 item to another listbox }
  240.       DragExtent  : TRect;    { extent of dragging area }
  241.       { *** working vars used for drag drawing *** }
  242.       DragDC      : hDC;      { used fro drag rectangle drawing }
  243.       MoveWithin,             { part of the dragging process }
  244.       ButtonDown,             { part of the dragging process }
  245.       Dragging    : BOOLEAN;  { part of the dragging process }
  246.       OrigRect,               { original location of dragged item }
  247.       DragRect    : TRect;    { rectangle being dragged }
  248.       LastPos     : TPoint;   { last drag point }
  249.       OldPen,                 { part of drag drawing }
  250.       TheBlackPen : hPen;     { part of drag drawing }
  251.       OldROP2     : INTEGER;  { part of drag drawing }
  252.       { *** Methods *** }
  253.       CONSTRUCTOR Init(AParent    : PWindowsObject;
  254.                        AnId       : INTEGER;
  255.                        x,y,w,h    : INTEGER;
  256.                        ADelOnTrfr : BOOLEAN);
  257.       CONSTRUCTOR InitResource(AParent    : PWindowsObject;
  258.                                AnId       : INTEGER;
  259.                                ADelOnTrfr : BOOLEAN);
  260.       FUNCTION GetClassName : PChar; VIRTUAL;
  261.       PROCEDURE GetWindowClass(VAR AWndClass: TWndClass); VIRTUAL;
  262.       PROCEDURE SetupWindow; VIRTUAL;
  263.       FUNCTION GetItemFromY(Y: INTEGER) : INTEGER;
  264.       PROCEDURE GetSelIndexRect(VAR ARect: TRect);
  265.       PROCEDURE wmChgLbItemPos(VAR Msg: TMessage);
  266.          VIRTUAL wm_First + wm_ChgLbItemPos;
  267.       PROCEDURE wmDelOnTrfr(VAR Msg: TMessage);
  268.          VIRTUAL wm_First + wm_DelOnTrfr;
  269.       PROCEDURE wmGetDragExtent(VAR Msg: TMessage);
  270.          VIRTUAL wm_First + wm_GetDragExtent;
  271.       PROCEDURE wmGetItemDragExtent(VAR Msg: TMessage);
  272.          VIRTUAL wm_First + wm_GetItemDragExtent;
  273.       PROCEDURE wmLButtonDown(VAR Msg: TMessage);
  274.          VIRTUAL wm_First + wm_LButtonDown;
  275.       PROCEDURE wmMouseMove(VAR Msg: TMessage);
  276.          VIRTUAL wm_First + wm_MouseMove;
  277.       PROCEDURE wmLButtonUp(VAR Msg: TMessage);
  278.          VIRTUAL wm_First + wm_LButtonUp;
  279.       PROCEDURE wmSetDragExtent(VAR Msg: TMessage);
  280.          VIRTUAL wm_First + wm_SetDragExtent;
  281.       PROCEDURE wmSetKeepSel(VAR Msg: TMessage);
  282.          VIRTUAL wm_First + wm_SetKeepSel;
  283.       PROCEDURE wmTrfrLbItem(VAR Msg: TMessage);
  284.          VIRTUAL wm_First + wm_TrfrLbItem;
  285.    END;
  286.  
  287. { ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }
  288.  
  289. IMPLEMENTATION
  290.  
  291. { ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }
  292.  
  293. USES
  294.  
  295.    BWCC,
  296.    Strings,
  297.    Strings1;
  298.  
  299. { ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }
  300.  
  301. { Description :
  302.  
  303.   As per normal listbox Init except for the 'ADelOnTrfr' flag. If the
  304.   latter is passed as TRUE then when an item is dragged to another
  305.   listbox it is deleted from its start listbox. }
  306.  
  307. CONSTRUCTOR TDndListBox.Init(AParent    : PWindowsObject;
  308.                              AnId       : INTEGER;
  309.                              x,y,w,h    : INTEGER;
  310.                              ADelOnTrfr : BOOLEAN);
  311. BEGIN
  312.    INHERITED Init(AParent,AnId,x,y,w,h);
  313.    ButtonDown := FALSE;
  314.    DelOnTrfr := ADelOnTrfr;
  315.    KeepSel := FALSE;
  316. END;
  317.  
  318. { ----------------------------------------------------------------------- }
  319.  
  320. { Description :
  321.  
  322.   As per normal listbox 'InitResource' except for the 'ADelOnTrfr' flag.
  323.   If the latter is passed as TRUE then when an item is dragged to another
  324.   listbox it is deleted from its start listbox. }
  325.  
  326. CONSTRUCTOR TDndListBox.InitResource(AParent    : PWindowsObject;
  327.                                      AnId       : INTEGER;
  328.                                      ADelOnTrfr : BOOLEAN);
  329. BEGIN
  330.    INHERITED InitResource(AParent,AnId);
  331.    ButtonDown := FALSE;
  332.    DelOnTrfr := ADelOnTrfr;
  333.    KeepSel := FALSE;
  334. END;
  335.  
  336. { ----------------------------------------------------------------------- }
  337.  
  338. FUNCTION TDndListBox.GetClassName : PChar;
  339. BEGIN
  340.    GetClassName := 'DndListBox';
  341. END;
  342.  
  343. { ----------------------------------------------------------------------- }
  344.  
  345. PROCEDURE TDndListBox.GetWindowClass(VAR AWndClass: TWndClass);
  346. BEGIN
  347.    INHERITED GetWindowClass(AWndClass);
  348. END;
  349.  
  350. { ----------------------------------------------------------------------- }
  351.  
  352. PROCEDURE TDndListBox.SetupWindow;
  353. VAR
  354.    ATRect : TRect;
  355.    ATPt : TPoint;
  356. BEGIN
  357.    INHERITED SetupWindow;
  358.    { By default set the drag extent rectangle to be the screen area
  359.      covered by the parent dialog client rectangle }
  360.    GetClientRect(Parent^.hWindow,ATRect);
  361.    ATPt.X := ATRect.Left;
  362.    ATPt.Y := ATRect.Top;
  363.    ClientToScreen(Parent^.hWindow,ATPt);
  364.    DragExtent.Left := ATPt.X;
  365.    DragExtent.Top := ATPt.Y;
  366.    ATPt.X := ATRect.Right;
  367.    ATPt.Y := ATRect.Bottom;
  368.    ClientToScreen(Parent^.hWindow,ATPt);
  369.    DragExtent.Right := ATPt.X;
  370.    DragExtent.Bottom := ATPt.Y;
  371. END;
  372.  
  373. { ----------------------------------------------------------------------- }
  374.  
  375. { Description:
  376.  
  377.   Returns the listbox item number from a listbox client window
  378.   co-ordinate Y value. }
  379.  
  380. FUNCTION TDndListBox.GetItemFromY(Y: INTEGER) : INTEGER;
  381. VAR
  382.    ItemHt,FromTop,TopItem: INTEGER;
  383. BEGIN
  384.    ItemHt := SendMessage(hWindow,lb_GetItemHeight,WORD(GetSelIndex),0);
  385.    FromTop := Y DIV ItemHt;
  386.    TopItem := SendMessage(hWindow,lb_GetTopIndex,0,0);
  387.    GetItemFromY := TopItem + FromTop;
  388. END;
  389.  
  390. { ----------------------------------------------------------------------- }
  391.  
  392. { Description:
  393.  
  394.   Returns the client window TRect position of the current listbox item. }
  395.  
  396. PROCEDURE TDndListBox.GetSelIndexRect(VAR ARect: TRect);
  397. BEGIN
  398.    SendMessage(hWindow,lb_GetItemRect,GetSelIndex,LONGINT(@ARect))
  399. END;
  400.  
  401. { ----------------------------------------------------------------------- }
  402.  
  403. { Custom message: This message is sent by the same listbox to itself
  404.                   whenever a listbox item has been dragged to a new
  405.                   position. Msg.lParamlo is the item number of the
  406.                   item being dragged; Msg.lParamHi is the new position
  407.                   number - both numbers are base 0. If Msg.lParamHi is
  408.                   -1 then the item is being moved to the end of the
  409.                   list. }
  410.  
  411. PROCEDURE TDndListBox.wmChgLbItemPos(VAR Msg: TMessage);
  412. VAR
  413.    ErrCode,L,StartItem,TargetItem : INTEGER;
  414.    AStr : PChar;
  415. BEGIN
  416.    StartItem := INTEGER(Msg.lParamLo);
  417.    TargetItem := INTEGER(Msg.lParamHi);
  418.    L := GetStringLen(StartItem)+1;
  419.    GetMem(AStr,L);
  420.    ErrCode := GetSelString(AStr,L);
  421.    ErrCode := DeleteString(StartItem);
  422.    UpdateWindow(hWindow);
  423.    IF TargetItem = -1 THEN
  424.       ErrCode := InsertString(AStr,-1)
  425.    ELSE
  426.    BEGIN
  427.       IF TargetItem > StartItem THEN
  428.          ErrCode := InsertString(AStr,TargetItem-1)
  429.       ELSE
  430.          ErrCode := InsertString(AStr,TargetItem);
  431.    END;
  432.    ErrCode := SetSelString(AStr,0);
  433.    FreeMem(AStr,L);
  434. END;
  435.  
  436. { ----------------------------------------------------------------------- }
  437.  
  438. { Custom message: This message is sent by the listbox to itself
  439.                   whenever an item has been dragged outside to
  440.                   another listbox. By default this method will
  441.                   delete the dragged item from the starting lb if
  442.                   the 'DelOnTrfr' boolean flag is set to TRUE.
  443.                   Msg.wParam holds the item number. }
  444.  
  445. PROCEDURE TDndListBox.wmDelOnTrfr(VAR Msg: TMessage);
  446. VAR
  447.    SelIdx : INTEGER;
  448. BEGIN
  449.    IF DelOnTrfr THEN
  450.    BEGIN
  451.       SelIdx := Msg.wParam;
  452.       DeleteString(SelIdx);
  453.       IF (GetCount > 0) AND KeepSel THEN
  454.       BEGIN
  455.          IF SelIdx >= GetCount THEN
  456.             SetSelIndex(GetCount-1)
  457.          ELSE
  458.             SetSelIndex(SelIdx)
  459.       END
  460.    END
  461. END;
  462.  
  463. { ----------------------------------------------------------------------- }
  464.  
  465. { Custom message:  Asks the receiving listbox for the current DragExtent
  466.                    TRect values. Msg.lParam holds a ptr to a TRect
  467.                    structure where the value is to be copied into. }
  468.  
  469. PROCEDURE TDndListBox.wmGetDragExtent(VAR Msg: TMessage);
  470. BEGIN
  471.    MOVE(DragExtent,POINTER(Msg.lParam)^,SIZEOF(DragExtent));
  472. END;
  473.  
  474. { ----------------------------------------------------------------------- }
  475.  
  476. { Custom message: used to find the mouse clipcursor TRectangle for
  477.                   a specified listbox item. Msg.wParam holds the
  478.                   listbox item index (base 0); whilst Msg.lParam
  479.                   holds a pointer to a TRect record. By default
  480.                   the message returns the standard DragExtent
  481.                   TRect values assigned within the SetupWindow
  482.                   method. }
  483.  
  484. PROCEDURE TDndListBox.wmGetItemDragExtent(VAR Msg: TMessage);
  485. VAR
  486.    ATRect : PRect;
  487. BEGIN
  488.    MOVE(DragExtent,POINTER(Msg.lParam)^,SIZEOF(DragExtent));
  489. END;
  490.  
  491. { ----------------------------------------------------------------------- }
  492.  
  493. PROCEDURE TDndListBox.wmLButtonDown(VAR Msg: TMessage);
  494. VAR
  495.    TargetItem: INTEGER;
  496.    ClipTRect : TRect;
  497. BEGIN
  498.    IF (NOT ButtonDown) THEN
  499.    BEGIN
  500.       { store mouse Pos }
  501.       LastPos.X := Msg.lParamLo;
  502.       LastPos.Y := Msg.lParamHi;
  503.       { update sel idx based on mouse pt }
  504.       TargetItem := GetItemFromY(Msg.lParamHi);
  505.       IF TargetItem <= (GetCount-1) THEN
  506.       BEGIN
  507.          SetSelIndex(TargetItem);
  508.          GetSelIndexRect(OrigRect);
  509.          MOVE(OrigRect,DragRect,SIZEOF(OrigRect));
  510.          IF PtInRect(DragRect,LastPos) THEN
  511.          BEGIN
  512.             ButtonDown := TRUE;
  513.             { restrict cursor movement to the ClipTRect screen area }
  514.             SendMessage(hWindow,
  515.                         wm_GetItemDragExtent,
  516.                         TargetItem,
  517.                         LONGINT(@ClipTRect));
  518.             ClipCursor(@ClipTRect);
  519.             { restrict mouse messages to this window }
  520.             SetCapture(hWindow);
  521.             { obtain window's DC }
  522.             DragDC := GetDC(hWindow);
  523.             Dragging := FALSE;
  524.             { set device context }
  525.             TheBlackPen := GetStockObject(Black_Pen);
  526.             OldPen := SelectObject(DragDC,TheBlackPen);
  527.             OldROP2 := SetROP2(DragDC,R2_NotXorPen);
  528.          END
  529.       END
  530.    END;
  531.    DefWndProc(Msg);
  532. END;
  533.  
  534. { ----------------------------------------------------------------------- }
  535.  
  536. PROCEDURE TDndListBox.wmMouseMove(VAR Msg: TMessage);
  537. VAR
  538.    NewPt : TPoint;
  539. BEGIN
  540.    IF ButtonDown THEN
  541.    BEGIN
  542.       { draw reactangle }
  543.       IF Dragging THEN
  544.       BEGIN
  545.          WITH DragRect DO
  546.             Rectangle(DragDC,Left,Top,Right,Bottom);
  547.       END;
  548.       Dragging := TRUE;
  549.       MOVE(Msg.lParam,NewPt,SIZEOF(NewPt));
  550.       { offset rectangle pos }
  551.       OffSetRect(DragRect,
  552.                  NewPt.X - LastPos.X,
  553.                  NewPt.Y - LastPos.Y);
  554.       { draw rectangle }
  555.       WITH DragRect DO
  556.          Rectangle(DragDC,Left,Top,Right,Bottom);
  557.       { store mouse Pos }
  558.       MOVE(NewPt,LastPos,SIZEOF(NewPt));
  559.    END
  560. END;
  561.  
  562. { ----------------------------------------------------------------------- }
  563.  
  564. PROCEDURE TDndListBox.wmLButtonUp(VAR Msg: TMessage);
  565. VAR
  566.    CRect : TRect;
  567.    ATPt : TPoint;
  568.    ScreenY,SelIdx,TargetIdx : INTEGER;
  569.    OtherClassName : ARRAY[0..80] OF CHAR;
  570.    OtherWnd : hWnd;
  571.    OtherCtrl : PWindowsObject;
  572.    MsgRes : LONGINT;
  573.  
  574.    { ++++++++++++++++++++++++++++++++++++++++++++++++++ }
  575.  
  576.    FUNCTION MatchWnd(AWnd: PWindowsObject) : BOOLEAN; FAR;
  577.    BEGIN
  578.       MatchWnd := ( AWnd^.hWindow = OtherWnd );
  579.    END;
  580.  
  581.    { ++++++++++++++++++++++++++++++++++++++++++++++++++ }
  582.  
  583. BEGIN
  584.    IF ButtonDown THEN
  585.    BEGIN
  586.       WITH DragRect DO
  587.          Rectangle(DragDC,Left,Top,Right,Bottom);
  588.       { restore DC }
  589.       SelectObject(DragDC,OldPen);
  590.       SetROP2(DragDC,OldROP2);
  591.       ReleaseDC(hWindow,DragDC);
  592.       { reset flags }
  593.       ReleaseCapture;
  594.       { restore cursor clip region to full screen }
  595.       ClipCursor(NIL);
  596.       GetClientRect(hWindow,CRect);
  597.       { is the end drag position within the listbox?}
  598.       IF Dragging THEN
  599.       BEGIN
  600.          { is it within the starting listbox? }
  601.          IF PtInRect(CRect,TPoint(Msg.lParam)) THEN
  602.          BEGIN
  603.             { stay within starting listbox item rectangle? }
  604.             IF (NOT PtInRect(OrigRect,TPoint(Msg.lParam)))
  605.             AND (GetCount > 1) THEN
  606.             BEGIN
  607.                TargetIdx := GetItemFromY(Msg.lParamHi);
  608.                IF TargetIdx > GetCount THEN
  609.                   TargetIdx := -1;
  610.                SelIdx := GetSelIndex;
  611.                SendMessage(hWindow,
  612.                            wm_ChgLbItemPos,
  613.                            0,
  614.                            MakeLong(WORD(SelIdx),WORD(TargetIdx)));
  615.             END
  616.          END
  617.          ELSE  { dragged outside of starting listbox }
  618.          BEGIN
  619.             { convert end pt to parent window client coords }
  620.             ATPt.X := TPoint(Msg.lParam).X;
  621.             ATPt.Y := TPoint(Msg.lParam).Y;
  622.             ClientToScreen(hWindow,ATPt);
  623.             ScreenY := ATPt.Y;
  624.             ScreenToClient(Parent^.hWindow,ATPt);
  625.             OtherWnd := ChildWindowFromPoint(Parent^.hWindow,ATPt);
  626.             { is it outside all other controls or part of start window? }
  627.             IF (OtherWnd = Parent^.hWindow) OR (OtherWnd = hWindow) THEN
  628.                MessageBeep(0)
  629.             ELSE
  630.             BEGIN
  631.                { Get OtherWnd class name }
  632.                OtherCtrl := Parent^.FirstThat(@MatchWnd);
  633.                IF (OtherCtrl = NIL) THEN
  634.                   MessageBeep(0)
  635.                ELSE
  636.                BEGIN
  637.                   StrCopy(OtherClassName,OtherCtrl^.GetClassName);
  638.                   IF SafeStrIComp(OtherClassName,'DndListBox') <> 0 THEN
  639.                      MessageBeep(0)
  640.                   ELSE
  641.                   BEGIN
  642.                      SelIdx := GetSelIndex;
  643.                      MsgRes := SendMessage(OtherWnd,
  644.                                            wm_TrfrLbItem,
  645.                                            WORD(hWindow),
  646.                                            MakeLong(WORD(SelIdx),WORD(ScreenY)));
  647.                      { delete the item from the starting lb }
  648.                      IF MsgRes <> 0 THEN
  649.                         SendMessage(hWindow,
  650.                                     wm_DelOnTrfr,
  651.                                     WORD(SelIdx),
  652.                                     0);
  653.                   END
  654.                END
  655.             END
  656.          END
  657.       END;
  658.       ButtonDown := FALSE;
  659.       Dragging := FALSE;
  660.    END;
  661.    DefWndProc(Msg);
  662. END;
  663.  
  664. { ----------------------------------------------------------------------- }
  665.  
  666. { Custom message: Sent to the listbox - usually by the owning dialog
  667.                   window - to set the rectangle over which the item
  668.                   can be dragged. Msg.lParam holds a ptr to a TRect
  669.                   structure. The TRect structure is presumed to hold
  670.                   absolute screen coords. The TRect is used to update
  671.                   the DragExtent object data field, which in turn is
  672.                   used as a parameter for the 'ClipCursor()' function
  673.                   within the wmLButtonDown method. }
  674.  
  675. PROCEDURE TDndListBox.wmSetDragExtent(VAR Msg: TMessage);
  676. BEGIN
  677.    MOVE(POINTER(Msg.lParam)^,DragExtent,SIZEOF(DragExtent));
  678. END;
  679.  
  680. { ----------------------------------------------------------------------- }
  681.  
  682. { Custom message: The 'KeepSel' object boolean data flag is used to
  683.                   determine whether the item selected hilite bar should
  684.                   be maintained on a listbox after an item has been
  685.                   dragged into another listbox. This message is used
  686.                   to update that flag. Msg.wParam holds a boolean
  687.                   value. }
  688.  
  689. PROCEDURE TDndListBox.wmSetKeepSel(VAR Msg: TMessage);
  690. BEGIN
  691.    KeepSel := BOOLEAN(Msg.wParam);
  692. END;
  693.  
  694. { ----------------------------------------------------------------------- }
  695.  
  696. { Custom message: This message is received by a listbox when an item
  697.                   from another listbox has been dragged over and dropped
  698.                   onto this listbox. Msg.wParam holds the Other ListBox
  699.                   window handle (hWnd); Msg.lParamLo is the item number
  700.                   (base 0) of the other listbox item; Msg.lParamHi is
  701.                   the absolute screen Y position where the item was
  702.                   dropped. If the target listbox is able to accept the
  703.                   dropped item then it returns Msg.Result set to non zero.
  704.                   If the dropped item is not accepted then Msg.Result
  705.                   is set to zero. }
  706.  
  707. PROCEDURE TDndListBox.wmTrfrLbItem(VAR Msg: TMessage);
  708. VAR
  709.    OtherLbWnd : hWnd;
  710.    L,TargetItem,StartItem : INTEGER;
  711.    AStr : PChar;
  712. BEGIN
  713.    OtherLbWnd := hWnd(Msg.wParam);
  714.    StartItem := INTEGER(Msg.lParamLo);
  715.    { find listbox y position }
  716.    ScreenToClient(HWindow,TPoint(Msg.lParam));
  717.    TargetItem := GetItemFromY(Msg.lParamHi);
  718.    IF TargetItem > (GetCount-1) THEN
  719.       TargetItem := -1;
  720.    { get the other listbox item string }
  721.    L := SendMessage(OtherLbWnd,lb_GetTextLen,StartItem,0) + 1;
  722.    GetMem(AStr,L);
  723.    SendMessage(OtherLbWnd,lb_GetText,StartItem,LONGINT(AStr));
  724.    { insert item into listbox }
  725.    InsertString(AStr,TargetItem);
  726.    { give the new item the focus }
  727.    IF TargetItem = -1 THEN
  728.       SetSelString(AStr,GetCount-2)
  729.    ELSE
  730.       SetSelString(AStr,TargetItem-1);
  731.    FreeMem(AStr,L);
  732.    Msg.Result := 1;
  733. END;
  734.  
  735. { ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }
  736.  
  737. BEGIN
  738.  
  739. END.